home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / DeHQX 2.0.0 / source / Preferences.p < prev    next >
Encoding:
Text File  |  1991-08-23  |  11.9 KB  |  490 lines  |  [TEXT/PJMM]
  1. unit Preferences;
  2. { DeHQX v2.0.0 © Peter Lewis, Aug 1991 }
  3.  
  4. interface
  5.  
  6.     uses
  7.         MyTypes, MyUtilities, MyFileSystem, MyStandardFile, Folders, MySystem7, AppGlobals;
  8.  
  9.     type
  10.     { DONT REORDER THIS RECORD OR THESE TYPES! }
  11.         promptStates = (PS_Always, PS_Exists, PS_Overwrite, PS_Unique, PS_Skip);
  12.         createDirStates = (CDS_Always, CDS_Folder, CDS_Never);
  13.         displayStates = (DS_All, DS_TEXT, DS_HQX);
  14.         preferencesType = record
  15.                 version: integer;
  16.                 prompt_state: promptStates;
  17.                 create_dir_state: createDirStates;
  18.                 display_state: displayStates;
  19.                 beep_state: boolean;
  20.                 delete_state: boolean;
  21.                 parts_state: boolean;
  22.                 startup_state: boolean;
  23.                 auto_quit_state: boolean;
  24.                 notify_state: boolean;
  25.                 demand_thisfile_state: boolean;
  26. {space for future expansion (rapidly shrinking!) }
  27.                 dummy4, dummy5, dummy6: boolean; { not packed }
  28. {added for version 1.1.2 }
  29.                 drop_folder: boolean;  { drop folder enabled }
  30.                 drop_dirID: longInt; { -1 for invalid directories }
  31.                 case boolean of
  32.                     true: ( { In memory }
  33.                             drop_vrn: integer
  34.                     );
  35.                     false: ( { On Disk }
  36.                             drop_CrDate: longInt;
  37.                             drop_Volume: str63
  38.                     );
  39.             end;
  40.  
  41.     const
  42.         Pref_Save_item = 1;
  43.         Pref_Default_Item = Pref_Save_item;
  44.         Pref_Cancel_item = 2;
  45.         Pref_OK_item = 3;
  46.  
  47.     var
  48.         prefs: preferencesType;
  49.         prefs_dialog: dialogPtr;  { nil if no window open }
  50.  
  51.     procedure InitPreferences;
  52.     function FinishPreferences: boolean;
  53.     procedure GetPreferences (wdrn: integer; dirID: longInt; name: str63);  { used for ODoc/Params }
  54.     procedure OpenPreferences;
  55.     procedure HandlePrefItem (item: integer);
  56.     procedure ClosePreferences;
  57.  
  58. implementation
  59.  
  60.     const
  61.         nonotify_version = $102;
  62.         notify_version = $106;
  63.         pre_drop_size = 16;
  64.         drop_version = $112;
  65.         current_version = $112;
  66.         User_item = 4;
  67.         PS_item = 5;
  68.         PS_items = 5;
  69.         PS_iteml = PS_item + PS_items - 1;
  70.         CDS_item = 10;
  71.         CDS_items = 3;
  72.         CDS_iteml = CDS_item + CDS_items - 1;
  73.         DS_item = 13;
  74.         DS_items = 3;
  75.         DS_iteml = DS_item + DS_items - 1;
  76.         PaS_item = 16;
  77.         DTFS_item = 17;
  78.         StS_item = 18;
  79.         DFS_item = 19;
  80.         DeS_item = 20;
  81.         BeS_item = 21;
  82.         FAS_item = 22;
  83.         AQS_item = 23;
  84.         DFB_item = 24;
  85.  
  86.     type
  87.         prefP = ^preferencesType;
  88.         prefH = ^prefP;
  89.  
  90.     var
  91.         noAlert: boolean;
  92.         prefVRN: integer;
  93.         prefDirID: longInt;
  94.         dialog_vrn: integer;
  95.         dialog_DirID: longInt;
  96.         prefs_dialog_dirty: boolean;
  97.  
  98.     procedure GetPrefVRN;
  99.         var
  100.             oe: OSErr;
  101.             vrn: integer;
  102.             crdate: longInt;
  103.     begin
  104.         with prefs do begin
  105.             if (drop_volume = '') or (drop_dirID = -1) then
  106.                 oe := myErr
  107.             else begin
  108.                 vrn := 0;
  109.                 oe := GetVolInfo(drop_volume, vrn, -1, crdate);
  110.                 if (oe = noErr) and (crdate <> drop_crdate) then
  111.                     oe := myErr;
  112.                 if oe = noErr then
  113.                     if not MFSDirExists(vrn, drop_dirID, '') then
  114.                         oe := myErr;
  115.             end;
  116.             if oe <> noErr then
  117.                 drop_folder := false;
  118.             if oe = noErr then begin
  119.                 drop_vrn := vrn;
  120.             end
  121.             else begin
  122.                 drop_vrn := 0;
  123.                 drop_dirID := -1;
  124.             end;
  125.         end;
  126.     end;
  127.  
  128.     procedure InitPreferences;
  129.         var
  130.             oe: OSErr;
  131.             name: str63;
  132.             pb: HParamBlockRec;
  133.             h: prefH;
  134.             wd: integer;
  135.     begin
  136.         noAlert := false;
  137.         with prefs do begin
  138.             version := current_version;
  139.             prompt_state := PS_Exists;
  140.             create_dir_state := CDS_Folder;
  141.             display_state := DS_TEXT;
  142.             beep_state := true;
  143.             delete_state := false;
  144.             parts_state := true;
  145.             startup_state := true;
  146.             auto_quit_state := false;
  147.             notify_state := true;
  148.             demand_thisfile_state := false;
  149.             dummy4 := false;
  150.             dummy5 := false;
  151.             dummy6 := false;
  152.             drop_folder := false;
  153.             drop_DirID := -1;
  154.             drop_Volume := '';
  155.         end;
  156.         h := prefH(GetResource(pref_rsrc, pref_id));
  157.         if h <> nil then begin
  158.             prefs := h^^;
  159.             ReleaseResource(handle(h));
  160.         end;
  161.         prefVRN := sysenv.sysVRefNum;
  162.         prefDirID := 0;
  163.         oe := GetDirID(prefVRN, prefVRN, prefDirID);
  164.         oe := MyFindFolder(prefVRN, kPreferencesFolderType, prefVRN, prefDirID);
  165.         GetPrefVRN;
  166.         noAlert := true;
  167.         GetPreferences(prefVRN, prefDirID, GetGlobalString(pref_name));
  168.         noAlert := false;
  169.         prefs_dialog := nil;
  170.     end;
  171.  
  172.     procedure GetPreferences (wdrn: integer; dirID: longInt; name: str63);
  173.         var
  174.             oe: OSErr;
  175.             rn, a: integer;
  176.             p: preferencesType;
  177.             count: longInt;
  178.     begin
  179.         oe := MyResolveAliasFile(wdrn, dirID, name);
  180.         if oe = noErr then
  181.             oe := MFSOpenDF(rn, wdrn, dirID, name, PIn);
  182.         if oe = noErr then begin
  183.             count := SizeOf(preferencesType);
  184.             oe := FSRead(rn, count, @p);
  185.             if oe = eofErr then
  186.                 oe := noErr;
  187.             if (count = pre_drop_size) and (p.version < drop_version) then begin
  188.                 p.drop_folder := false;
  189.                 p.drop_DirID := -1;
  190.                 p.drop_Volume := '';
  191.                 count := SizeOf(preferencesType);
  192.             end;
  193.             if count <> SizeOf(preferencesType) then
  194.                 oe := myErr;
  195.             if oe = noErr then begin
  196.                 prefs := p;
  197.                 if prefs.version < notify_version then
  198.                     prefs.notify_state := true;
  199.                 prefs.version := current_version;
  200.                 GetPrefVRN;
  201.             end
  202.             else if not noAlert then
  203.                 a := Alert(pref_read_alert_id, nil);
  204.             oe := FSClose(rn);
  205.         end;
  206.     end;
  207.  
  208.     procedure SaveDefaults;
  209.         var
  210.             oe: OSErr;
  211.             rn, a: integer;
  212.             count: longInt;
  213.             p: preferencesType;
  214.             name: str63;
  215.             crdate: longInt;
  216.     begin
  217.         p := prefs;
  218.         with p do begin
  219.             if drop_dirID = -1 then
  220.                 oe := myErr
  221.             else begin
  222.                 name := '';
  223.                 oe := GetVolInfo(name, drop_vrn, -1, crdate);
  224.             end;
  225.             if oe = noErr then begin
  226.                 drop_volume := name;
  227.                 drop_CrDate := crdate;
  228.             end
  229.             else begin
  230.                 drop_folder := false;
  231.                 drop_DirID := -1;
  232.                 drop_CrDate := 0;
  233.                 drop_Volume := '';
  234.             end;
  235.         end;
  236.         oe := MFSCreate(prefVRN, prefDirID, GetGlobalString(pref_name), myAppType, myAppType);
  237.         oe := MFSOpenDF(rn, prefVRN, prefDirID, GetGlobalString(pref_name), POut);
  238.         if oe = noErr then begin
  239.             count := SizeOf(preferencesType);
  240.             oe := FSWrite(rn, count, @p);
  241.             if count <> SizeOf(preferencesType) then
  242.                 oe := myErr;
  243.             if (oe <> noErr) and not noAlert then
  244.                 a := Alert(pref_write_alert_id, nil);
  245.             if oe = noErr then
  246.                 oe := FSClose(rn);
  247.         end;
  248.     end;
  249.  
  250.     function FinishPreferences: boolean;
  251.     begin
  252.         if prefs_dialog <> nil then
  253.             ClosePreferences;
  254.         FinishPreferences := prefs_dialog <> nil;
  255.     end;
  256.  
  257.     function GetControl (dp: dialogPtr; item: integer): boolean;
  258.         var
  259.             kind: integer;
  260.             r: rect;
  261.             h: controlHandle;
  262.     begin
  263.         GetDItem(dp, item, kind, handle(h), r);
  264.         GetControl := GetCtlValue(h) <> 0;
  265.     end;
  266.  
  267.     procedure SetControl (dp: dialogPtr; item: integer; on: boolean);
  268.         var
  269.             kind: integer;
  270.             r: rect;
  271.             h: controlHandle;
  272.     begin
  273.         GetDItem(dp, item, kind, handle(h), r);
  274.         SetCtlValue(h, ord(on));
  275.         prefs_dialog_dirty := true;
  276.     end;
  277.  
  278.     procedure SetControls (dp: dialogPtr; first, count, value: integer);
  279.         var
  280.             i: integer;
  281.     begin
  282.         for i := 0 to count - 1 do
  283.             SetControl(dp, first + i, i = value);
  284.     end;
  285.  
  286.     function GetControls (dp: dialogPtr; first, count: integer): integer;
  287.         var
  288.             i: integer;
  289.     begin
  290.         GetControls := 0;
  291.         for i := 0 to count - 1 do
  292.             if GetControl(dp, first + i) then
  293.                 GetControls := i;
  294.     end;
  295.  
  296.     procedure SetDropButton (dp: dialogPtr; folder: boolean; vrn: integer; dirID: longInt);
  297.         var
  298.             pb: HParamBlockRec;
  299.             name: str255;
  300.             oe: OSErr;
  301.             kind: integer;
  302.             h: handle;
  303.             r: rect;
  304.     begin
  305.         dialog_vrn := vrn;
  306.         dialog_dirID := dirID;
  307.         if dirID = -1 then
  308.             oe := myErr
  309.         else
  310.             with pb do begin
  311.                 ioNamePtr := @name;
  312.                 ioVRefNum := vrn;
  313.                 ioFDirIndex := -1;
  314.                 ioDirID := dirID;
  315.                 oe := PBGetCatInfo(@pb, false);
  316.             end;
  317.         if oe <> noErr then begin
  318.             name := GetGlobalString(no_drop_folder);
  319.             folder := false;
  320.         end;
  321.         SetControl(dp, DFS_item, folder);
  322.         GetDItem(dp, DFB_item, kind, h, r);
  323.         SetCTitle(controlHandle(h), name);
  324.         prefs_dialog_dirty := true;
  325.     end;
  326.  
  327.     procedure SetDialog (dp: dialogPtr);
  328.     begin
  329.         with prefs do begin
  330.             SetControls(dp, PS_item, PS_items, ord(prompt_state));
  331.             SetControls(dp, CDS_item, CDS_items, ord(create_dir_state));
  332.             SetControls(dp, DS_item, DS_items, ord(display_state));
  333.             SetControl(dp, BeS_item, beep_state);
  334.             SetControl(dp, DeS_item, delete_state);
  335.             SetControl(dp, PaS_item, parts_state);
  336.             SetControl(dp, DTFS_item, demand_thisfile_state);
  337.             SetControl(dp, StS_item, startup_state);
  338.             SetControl(dp, AQS_item, auto_quit_state);
  339.             SetControl(dp, FAS_item, notify_state);
  340.             SetDropButton(dp, drop_folder, drop_vrn, drop_DirID);
  341.         end;
  342.     end;
  343.  
  344.     procedure SetPrefs (dp: dialogPtr);
  345.     begin
  346.         with prefs do begin
  347.             prompt_state := promptStates(GetControls(dp, PS_item, PS_items));
  348.             create_dir_state := createDirStates(GetControls(dp, CDS_item, CDS_items));
  349.             display_state := displayStates(GetControls(dp, DS_item, DS_items));
  350.             beep_state := GetControl(dp, BeS_item);
  351.             delete_state := GetControl(dp, DeS_item);
  352.             parts_state := GetControl(dp, PaS_item);
  353.             demand_thisfile_state := GetControl(dp, DTFS_item);
  354.             startup_state := GetControl(dp, StS_item);
  355.             auto_quit_state := GetControl(dp, AQS_item);
  356.             notify_state := GetControl(dp, FAS_item);
  357.             drop_folder := GetControl(dp, DFS_item);
  358.             drop_dirID := dialog_dirID;
  359.             drop_vrn := dialog_vrn;
  360.         end;
  361.     end;
  362.  
  363.     procedure OutlineDefault (dp: dialogPtr; item: integer);
  364.         var
  365.             kind: integer;
  366.             h: handle;
  367.             r: rect;
  368.     begin
  369.         GetDItem(dp, Pref_Default_item, kind, h, r);
  370.         PenSize(3, 3);
  371.         InsetRect(r, -4, -4);
  372.         FrameRoundRect(r, 16, 16);
  373.     end;
  374.  
  375.     procedure OpenPreferences;
  376.         var
  377.             item: integer;
  378.             kind: integer;
  379.             h: handle;
  380.             r: rect;
  381.     begin
  382.         if prefs_dialog <> nil then begin
  383.             if FrontWindow <> prefs_dialog then
  384.                 SelectWindow(prefs_dialog);
  385.         end
  386.         else begin
  387.             SetVersionParamText('', '');
  388.             prefs_dialog := GetNewDialog(pref_dialog_id, nil, POINTER(-1));
  389.             GetDItem(prefs_dialog, Pref_Default_item, kind, h, r);
  390.             InsetRect(r, -10, -10);
  391.             SetDItem(prefs_dialog, User_item, userItem, handle(@OutlineDefault), r);
  392.             SetDialog(prefs_dialog);
  393.             prefs_dialog_dirty := false;
  394.             ShowWindow(prefs_dialog);
  395.         end;
  396.     end;
  397.  
  398.     procedure HandlePrefItem (item: integer);
  399.         procedure CheckClick (item: integer);
  400.         begin
  401.             SetControl(prefs_dialog, item, not GetControl(prefs_dialog, item));
  402.         end;
  403.         var
  404.             reply: MySFReply;
  405.             typeList: SFTypeList;
  406.             dfs: boolean;
  407.     begin
  408.         with prefs do begin
  409.             case item of
  410.                 PS_item..PS_iteml: 
  411.                     SetControls(prefs_dialog, PS_item, PS_items, item - PS_item);
  412.                 CDS_item..CDS_iteml: 
  413.                     SetControls(prefs_dialog, CDS_item, CDS_items, item - CDS_item);
  414.                 DS_item..DS_iteml: 
  415.                     SetControls(prefs_dialog, DS_item, DS_items, item - DS_item);
  416.                 BeS_item: 
  417.                     CheckClick(BeS_item);
  418.                 DeS_item: 
  419.                     CheckClick(DeS_item);
  420.                 PaS_item: 
  421.                     CheckClick(PaS_item);
  422.                 DTFS_item: 
  423.                     CheckClick(DTFS_item);
  424.                 StS_item: 
  425.                     CheckClick(StS_item);
  426.                 AQS_item: 
  427.                     CheckClick(AQS_item);
  428.                 FAS_item: 
  429.                     CheckClick(FAS_item);
  430.                 DFS_item: 
  431.                     begin
  432.                     if GetControl(prefs_dialog, DFS_item) then
  433.                         SetControl(prefs_dialog, DFS_item, false)
  434.                     else if dialog_dirID = -1 then begin
  435.                         GetFolder(nil, -1, typeList, get_folder_id, reply);
  436.                         with reply do
  437.                             if Rgood then
  438.                                 SetDropButton(prefs_dialog, true, RvRefNum, RdirID);
  439.                     end
  440.                     else
  441.                         SetControl(prefs_dialog, DFS_item, true);
  442.                 end;
  443.                 DFB_item: 
  444.                     begin
  445.                     if dialog_dirID <> -1 then
  446.                         SetSFFile(dialog_vrn, dialog_dirID);
  447.                     GetFolder(nil, -1, typeList, get_folder_id, reply);
  448.                     with reply do
  449.                         if Rgood then
  450.                             SetDropButton(prefs_dialog, true, RvRefNum, RdirID);
  451.                 end;
  452.                 Pref_Save_item, Pref_OK_item, Pref_Cancel_item: 
  453.                     begin
  454.                     if prefs_dialog_dirty and (item <> Pref_Cancel_item) then begin
  455.                         SetPrefs(prefs_dialog);
  456.                         if item = Pref_Save_item then
  457.                             SaveDefaults;
  458.                     end;
  459.                     DisposDialog(prefs_dialog);
  460.                     prefs_dialog := nil;
  461.                 end;
  462.                 otherwise
  463.                     ;
  464.             end;
  465.         end;
  466.     end;
  467.  
  468.     procedure ClosePreferences;
  469.         var
  470.             dp: dialogPtr;
  471.             a: integer;
  472.     begin
  473.         if prefs_dialog_dirty then begin
  474.             if FrontWindow <> prefs_dialog then
  475.                 SelectWindow(prefs_dialog);
  476.             a := Alert(pref_save_changes_alert_id, nil); { 1=Save, 2 = Cancel, 3=Discard }
  477.         end
  478.         else
  479.             a := 3;
  480.         if a = 1 then begin
  481.             SetPrefs(prefs_dialog);
  482.             SaveDefaults;
  483.         end;
  484.         if a <> 2 then begin
  485.             DisposDialog(prefs_dialog);
  486.             prefs_dialog := nil;
  487.         end;
  488.     end;
  489.  
  490. end.